home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DIALOGS / JANUSW / DEBUG.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-14  |  7KB  |  279 lines
  1. {$A+,B-,G+,I-,O-,P+,Q-,R-,S-,T-,V-,X+}
  2. Unit Debug;
  3. { Unit:      Debug
  4.   Version:   1.00
  5.   Purpose:   useful functions for debug output
  6.   Uses:      DbWin or monochrome monitor as output device
  7.   Date:      09/20/94
  8.  
  9.   Developer: Peter Sawatzki (ps)
  10.              Buchenhof 3, 58091 Hagen, Germany
  11.  CompuServe: 100031,3002
  12.  
  13.   Contributing: Jeroen W. Pluimers (jwp), CIS: 100013,1443
  14.  
  15.   Date:    Author:
  16.   08/01/93 ps     wrote it
  17.   01/18/94 ps/jwp correct bug in debugoutput, add R- option
  18.   01/21/94 ps     minor 'optimizations'
  19.   09/20/94 ps/jwp add HexP, LogFile and DumpXXX stuff from Jeroen's version
  20.   09/21/94 ps     add DateTimeStr function
  21.  
  22.   Copyright (c) 1994 Peter Sawatzki. All Rights Reserved.
  23.  
  24. }
  25. Interface
  26. Uses
  27.   WinTypes,
  28.   WinProcs,
  29.   WinDos,
  30.   Strings;
  31. Type
  32.   Str2 = String[2];
  33.   Str4 = String[4];
  34.   Str8 = String[8];
  35.   Str9 = String[9];
  36.   Str10 = String[10];
  37.   PtrRec = Record
  38.              Ofs, Seg: Word
  39.            End;
  40.   LongRec = Record
  41.               LoWord, HiWord: Word
  42.             End;
  43.   pDataSeg = ^tDataSeg;
  44.   tDataSeg = Record
  45.     pNull:      LongInt; { 00 - always 0 }
  46.     pPtrCount:  Word;    { 04 - number of pointers in structure }
  47.     pLocalHeap: Word;    { 06 - near ptr to local heap }
  48.     pAtomTable: Word;    { 08 - near ptr to atom table within local heap }
  49.     pStackTop:  Word;    { 0A - near ptr to top of the stack        - SP can't go beyond this value }
  50.     pStackBot:  Word;    { 0C - near ptr to bottom of stack         - initial value of SP }
  51.     pStackMin:  Word;    { 0E - near ptr to lowest stack value used - lowest value of SP }
  52.   End;
  53.  
  54. Procedure BreakPoint; Inline($CC);
  55. Function HexB (b: Byte): Str2;
  56. Function HexW (w: Word): Str4;
  57. Function HexL (l: LongInt): Str8;
  58. Function HexP (aPtr: Pointer): Str9;
  59. Function L2S (l: LongInt): Str10;
  60. Function W2S (w: Word): Str10;
  61. Function StrPasEx(Str: pChar): String;
  62. Function DateTimeStr: String;
  63.  
  64. Procedure AssignDebug (Var F: Text);
  65.  
  66. Implementation
  67. Uses
  68.   {$IfDef Ver70} Win31, {$EndIf}
  69.   ToolHelp;
  70. Const
  71.   HC: Array[0..$F] Of Char = '0123456789ABCDEF';
  72.  
  73. Function HexB (b: Byte): Str2;
  74. Begin
  75.   HexB[0]:= #2;
  76.   HexB[1]:= HC[b Shr 4];
  77.   HexB[2]:= HC[b And $F]
  78. End;
  79.  
  80. Function HexW (w: Word): Str4;
  81. Begin
  82.   HexW[0]:= #4;
  83.   HexW[1]:= HC[w Shr 12];
  84.   HexW[2]:= HC[Hi(w) And $F];
  85.   HexW[3]:= HC[Lo(w) Shr 4];
  86.   HexW[4]:= HC[w And $F]
  87. End;
  88.  
  89. Function HexL (l: LongInt): Str8;
  90. Begin With LongRec(l) Do Begin
  91.   HexL[0]:= #8;
  92.   HexL[1]:= HC[HiWord Shr 12];
  93.   HexL[2]:= HC[Hi(HiWord) And $F];
  94.   HexL[3]:= HC[Lo(HiWord) Shr 4];
  95.   HexL[4]:= HC[HiWord And $F];
  96.   HexL[5]:= HC[LoWord Shr 12];
  97.   HexL[6]:= HC[Hi(LoWord) And $F];
  98.   HexL[7]:= HC[Lo(LoWord) Shr 4];
  99.   HexL[8]:= HC[LoWord And $F]
  100. End End;
  101.  
  102. Function HexP (aPtr: Pointer): Str9;
  103. Begin With LongRec(aPtr) Do Begin
  104.   HexP[0]:= #9;
  105.   HexP[1]:= HC[HiWord Shr 12];
  106.   HexP[2]:= HC[Hi(HiWord) And $F];
  107.   HexP[3]:= HC[Lo(HiWord) Shr 4];
  108.   HexP[4]:= HC[HiWord And $F];
  109.   HexP[5]:= ':';
  110.   HexP[6]:= HC[LoWord Shr 12];
  111.   HexP[7]:= HC[Hi(LoWord) And $F];
  112.   HexP[8]:= HC[Lo(LoWord) Shr 4];
  113.   HexP[9]:= HC[LoWord And $F]
  114. End End;
  115.  
  116. Function L2S (l: LongInt): Str10;
  117. Var
  118.   pStr: ^Str10;
  119. Begin
  120.   Asm Les Di, @Result; Mov Word(pStr), Di; Mov Word(pStr+2), Es End;
  121.   Str(l,pStr^)
  122. End;
  123.  
  124. Function W2S (w: Word): Str10;
  125. Var
  126.   pStr: ^Str10;
  127. Begin
  128.   Asm Les Di, @Result; Mov Word(pStr), Di; Mov Word(pStr+2), Es End;
  129.   Str(w,pStr^)
  130. End;
  131.  
  132. Function StrPasEx(Str: pChar): String;
  133. Begin
  134.   If PtrRec(Str).Seg=0 Then
  135.     StrPasEx:= '#'+L2S(Word(Str))
  136.   Else
  137.     StrPasEx:= StrPas(Str)
  138. End;
  139.  
  140. Function DateTimeStr: String;
  141. Var
  142.   y,m,d,dummy, h, min, s: Word;
  143. Begin
  144.   GetDate(y,m,d,dummy);
  145.   GetTime(h,min,s,dummy);
  146.   DateTimeStr:= L2S(y)+'/'+L2S(m)+'/'+L2S(d)+', '
  147.               + L2S(h)+':'+L2S(min)+':'+L2S(s)
  148. End;
  149.  
  150. {------------------------------------------ Debug output functions }
  151.  
  152. Procedure SpitOut (aStr: pChar);
  153. Const
  154.   OutputTo: (oDontKnow, oDbWin, oFile, oIgnore) = oDontKnow;
  155.   DebugFile = 'C:\DEBUG.LOG';
  156.  
  157.   Procedure SpitOutToFile (aStr: pChar);
  158.   Var
  159.     aTextFile: Text;
  160.     IoRes: Integer;
  161.   Begin
  162.     IoRes:= InOutRes; InOutRes:= 0;
  163.     Assign(aTextFile, DebugFile); Append(aTextFile);
  164.     If IoResult=0 Then Write(aTextFile, aStr);
  165.     If IoResult=0 Then Close(aTextFile);
  166.     InOutRes:= IoRes;
  167.   End;
  168.  
  169.   Procedure CheckOutput;
  170.   Var
  171.     ModuleEntry: tModuleEntry;
  172.     Tmp: Array[0..30] Of Char;
  173.     aTextFile: Text;
  174.     IoRes: Integer;
  175.   Begin
  176.     ModuleEntry.dwSize:= SizeOf(tModuleEntry);
  177.     If  (GetSystemMetrics(sm_debug)=0)
  178.     And (ModuleFindName(@ModuleEntry, 'DBWIN')=0) Then Begin
  179.       OutputTo:= oFile;
  180.       IoRes:= InOutRes; InOutRes:= 0;
  181.       Assign(aTextFile, DebugFile); Append(aTextFile);
  182.       If IoResult<>0 Then ReWrite(aTextFile);
  183.       If IoResult<>0 Then OutputTo:= oIgnore;
  184.       InOutRes:= IoRes
  185.     End Else
  186.       OutputTo:= oDbWin;
  187.     If OutputTo<>oIgnore Then Begin
  188.       SpitOut('---- Log startet on ');
  189.       SpitOut(StrPCopy(Tmp, DateTimeStr));
  190.       SpitOut(' ----'#13#10);
  191.       SpitOut(aStr)
  192.     End
  193.   End;
  194. Begin {$i-}
  195.   Case OutputTo Of
  196.     oDbWin: OutputDebugString(aStr);
  197.     oFile:  SpitOutToFile(aStr);
  198.     oDontKnow: CheckOutput;
  199.   End
  200. End;
  201.  
  202. Function DebugOutput (Var F: tTextRec): Integer; Far;
  203. Var
  204.   TwoCh: Array[0..1] Of Char;
  205. Begin
  206.   With F Do If BufPos>0 Then Begin
  207.     TwoCh[0]:= #0; TwoCh[1]:= #0;
  208.     If BufPos=BufSize Then Begin
  209.       Dec(BufPos);
  210.       TwoCh[0]:= BufPtr^[BufPos]
  211.     End;
  212.     BufPtr^[BufPos]:= #0;
  213.     SpitOut(pChar(BufPtr));
  214.     If TwoCh[0]<>#0 Then
  215.       SpitOut(TwoCh);
  216.     BufPos:= 0
  217.   End;
  218.   DebugOutput:= 0
  219. End;
  220.  
  221. Function DebugClose (Var F: tTextRec): Integer; Far;
  222. Begin
  223.   DebugClose:= 0
  224. End;
  225.  
  226. Function DebugOpen (Var F: tTextRec): Integer; Far;
  227. Begin With F Do Begin
  228.   Mode:= fmOutput;
  229.   InOutFunc:= @DebugOutput;
  230.   FlushFunc:= @DebugOutput;
  231.   CloseFunc:= @DebugClose;
  232.   DebugOpen:= 0
  233. End End;
  234.  
  235. Procedure AssignDebug (Var F: Text);
  236. Begin With tTextRec(F) Do Begin
  237.   Handle:= $FFFF;
  238.   Mode:= fmClosed;
  239.   BufSize:= SizeOf(Buffer);
  240.   BufPtr:= @Buffer;
  241.   OpenFunc:= @DebugOpen;
  242.   Name[0]:= #0
  243. End End;
  244.  
  245. Procedure DumpDefData;
  246. Var
  247.   DataSeg: pDataSeg;
  248. Begin
  249.   DataSeg := Ptr(DSeg, 0);
  250.   WriteLn('t DumpDefData - data segment: ',HexP(DataSeg));
  251.   With DataSeg^ Do Begin
  252.     WriteLn('t 00 pNull:      ',HexL(pNull));
  253.     WriteLn('t 04 pPtrCount:  ',HexW(pPtrCount));
  254.     WriteLn('t 06 pLocalHeap: ',HexW(pLocalHeap));
  255.     WriteLn('t 08 pAtomTable: ',HexW(pAtomTable));
  256.     WriteLn('t 0A pStackTop:  ',HexW(pStackTop));
  257.     WriteLn('t 0C pStackBot:  ',HexW(pStackBot));
  258.     WriteLn('t 0E pStackMin:  ',HexW(pStackMin));
  259.     WriteLn('t used stack:    ',Longint(pStackBot)-pStackMin,' (bytes)');
  260.     WriteLn('t stack size:    ',Longint(pStackBot)-pStackTop,' (bytes)');
  261.   End
  262. End;
  263.  
  264. Procedure DumpResourceInfo;
  265. Begin
  266.   WriteLn('t DumpResourceInfo - free resources');
  267.   WriteLn('System heap: ',GetFreeSystemResources(GFSR_SystemResources),' %');
  268.   WriteLn('GDI heap:    ',GetFreeSystemResources(GFSR_GDIResources),' %');
  269.   WriteLn('User heap:   ',GetFreeSystemResources(GFSR_UserResources),' %');
  270.   WriteLn('MemAvail:    ',MemAvail:8);
  271.   WriteLn('MaxAvail:    ',MaxAvail:8);
  272. End;
  273.  
  274. Begin
  275.   AssignDebug(Output);
  276.   Rewrite(Output)
  277. End.
  278.  
  279.